home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
design60.zip
/
WINDOWS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-05-13
|
4KB
|
184 lines
unit windows;
interface
Uses
Dos,
Crt;
procedure boxwin(x1,y1,x2,y2,t,b:integer;Border:Boolean);
procedure Init_Windows;
procedure Make_Window(x1,y1,x2,y2,t,b:integer;Border:Boolean);
procedure Remove_Window;
procedure Remove_Windows;
implementation
Const
FastVideo : Boolean = False;
type
string10 = string[10];
string80 = string[80];
imagetype = array [1..4096] of char;
windimtype = record
x1,y1,x2,y2: integer
end;
const maxwin = 5; { maximum number of windows open at once }
var
a: integer;
win: { Global variable package }
record
dim: windimtype; { Current window dimensions }
depth: integer;
WinStack: array[1..maxwin] of
record
image: imagetype; { Saved screen image }
dim: windimtype; { Saved window dimensions }
x,y: integer { Saved cursor position }
end
end;
crtmode: byte absolute $0040:$0049;
crtwidth: byte absolute $0040:$004A;
monobuffer: imagetype absolute $B000:$0000;
colorbuffer: imagetype absolute $B800:$0000;
{ ----------------------------------------------------- }
{ Call Init_Windows before calling Make_Window or Remove_Window. }
procedure Init_Windows;
{ Records initial window dimensions }
begin
with win.dim do
begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
win.depth:=0
end;
procedure boxwin(x1,y1,x2,y2,t,b:integer;Border:Boolean);
{ Draws a box, fills it with blanks, and makes it the current }
{ window. Dimensions given are for the box; actual window is }
{ one unit smaller in each direction. }
{ This routine can be used separately from the rest of the }
{ removable window package. }
var x,y: integer;
begin
textbackground(b);
window(1,1,80,25);
If Border Then
Begin
{ Top }
TextColor(t);
TextBackground(B);
GoToXY(x1,y1);
Write(#213);
for x:=x1+1 to x2-1 do
Begin
GoToXY(x,y);
Write(#205);
End;
GoToXY(x2,y1);
Write(#184);
{ Sides }
for y:=y1+1 to y2-1 do
Begin
GoToXY(x1,y);
Write(#179);
GoToXY(x2,y);
Write(#179);
End;
{ Bottom }
GoToXY(x1,y2);
Write(#212);
for x:=x1+1 to x2-1 do
Begin
GoToXY(x,y2);
Write(#205);
End;
Write(#190);
End;
{ Make it the current window }
If Border Then
window(x1+1,y1+1,x2-1,y2-1) Else
Window(x1,y1,x2,y2);
clrscr;
gotoxy(1,1)
end;
procedure Make_Window;
{ Create a removable window }
begin
{ Increment WinStack pointer }
with win do
If depth < MaxWin Then
depth:=depth+1;
if win.depth>maxwin then
begin
win.depth := MaxWin;
writeln(' Window nesting error. ');
exit
end;
{ Save contents of screen }
if crtmode = 7 then
win.WinStack[win.depth].image := monobuffer
else
win.WinStack[win.depth].image := colorbuffer;
win.WinStack[win.depth].dim := win.dim;
win.WinStack[win.depth].x := wherex;
win.WinStack[win.depth].y := wherey;
{ Create the window }
If Border Then
Begin
boxwin(x1,y1,x2,y2,t,b,Border);
win.dim.x1 := x1+1;
win.dim.y1 := y1+1; { Allow for margins }
win.dim.x2 := x2-1;
win.dim.y2 := y2-1;
End Else
Begin
BoxWin(X1,Y1,X2,Y2,t,b,Border);
win.dim.x1 := x1;
win.dim.y1 := y1; { Allow for margins }
win.dim.x2 := x2;
win.dim.y2 := y2;
End;
end;
procedure Remove_Window;
{ Remove the most recently created removable window }
{ Restore screen contents, window dimensions, and }
{ position of cursor. }
begin
if win.depth < 1 then exit;
if crtmode = 7 then
monobuffer := win.WinStack[win.depth].image
else
colorbuffer := win.WinStack[win.depth].image;
with win do
begin
dim := WinStack[depth].dim;
window(dim.x1,dim.y1,dim.x2,dim.y2);
gotoxy(WinStack[depth].x,WinStack[depth].y);
depth := depth - 1
end
end;
Procedure Remove_Windows;
Var
i : integer;
begin
for i := 1 to 5 do Remove_Window;
end;
end.